home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1993…ch: Other People's Memory / ADC Developer CD (1993-03) (''Other People's Memory'')_iso / Dev.CD Mar 93.iso / Development Platforms / LISP Related / LISP Goodies / styled-comments.lisp < prev    next >
Encoding:
Text File  |  1992-09-02  |  3.9 KB  |  97 lines  |  [TEXT/CCL2]
  1. ;;;-*-Mode: LISP; Package: CCL -*-
  2. ;;;
  3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  4. ;;;
  5. ;;; File: styled-comments.lisp
  6. ;;; Author: Bob Kass, EDS Center for Advanced Research (kass@cmi.com)
  7. ;;; Date: 7/30/92
  8. ;;; 
  9. ;;; For MCL 2.0.
  10. ;;;
  11. ;;; This file is an extension similar to style-definitions.lisp by Derek White.
  12. ;;; It will format all the semicolon/Carriage Return delimited comments
  13. ;;; in a buffer using *comment-style*, with the exception of the modeline.
  14. ;;;
  15. ;;; This is nice to set all your comments in italics to help set them off 
  16. ;;; from the rest of your code. 
  17. ;;;
  18. ;;; Loading the file will add a "Styled Comments" entry to the Edit menu,
  19. ;;; and bind it to the command-I keystroke.
  20. ;;;
  21. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  22.  
  23. (in-package :ccl)
  24. (export '*comment-style*)
  25.  
  26. (defvar *comment-style* '(:italic) "Specify the character style to use for comments")
  27.  
  28. (defconstant *set-comment-menu-name* "Styled Comments"
  29.   "The name of the 'Styled Comments' menu.")
  30.  
  31. (defmethod in-string-p ((b buffer-mark) position)
  32.   "This function is something of a kludge to see whether <position> is in the middle of a 
  33.    string.  First we find the beginning of the top-level sexp and then count the number of 
  34.    quotemarks between the beginning and <position>.  An odd number of quotes implies we're
  35.    in a string.  This will get confused by quotemarks that appear within a comment."
  36.   (let ((sexp-start (ccl::ed-top-level-sexp-start-pos b position t))
  37.         (quote-count 0)
  38.         )
  39.     (when sexp-start
  40.       (loop for i from sexp-start to position
  41.             if (and (eql (buffer-char b i) #\")
  42.                     (> i 0)
  43.                     (not (eql (buffer-char b (- i 1)) #\\)))    ; not a quote char
  44.             do (incf quote-count)
  45.             ))
  46.     (oddp quote-count)
  47.     ))
  48.  
  49. (defmethod set-comment-style ((w fred-window) font-spec)
  50.   "Change all comments (starting with a leading ';') in the buffer for this window 
  51.    to be displayed using *comment-style*"
  52.   (let ((b (fred-buffer w))
  53.         comment-begin
  54.         comment-end
  55.         )
  56.     ;;; skip over the modeline if there is one -- like to keep it in a normal style
  57.     (multiple-value-setq (comment-end comment-begin) (ccl::buffer-modeline-range b))
  58.     (when (not comment-begin)
  59.       (setf comment-begin 0)
  60.       )
  61.     (loop always (setf comment-begin (ccl::buffer-forward-search b #\; comment-begin))
  62.           do 
  63.           ;;; buffer-forward-search returns the position 1 passed the matching character,
  64.           ;;; so we need to decrement by 1 to refer to the actual position of the match
  65.           (unless (or (and (> comment-begin 1) 
  66.                            (eql (buffer-char b (- comment-begin 2)) #\\))    ; #\; isn't really a comment
  67.                       (in-string-p b (- comment-begin 1)))
  68.             (setf comment-end (ccl::buffer-forward-search b #\return comment-begin))
  69.             (buffer-set-font-spec b font-spec (- comment-begin 1) comment-end)
  70.             (setf comment-begin comment-end))
  71.           )
  72.     (fred-update w)
  73.     ))
  74.  
  75. (defun handle-set-comment-style (w)
  76.   "Handle the menu invocation by calling set-comment-style and setting up the Undo/Redo menu."
  77.   (set-comment-style w *comment-style*)
  78.   (setup-undo w
  79.               #'(lambda ()
  80.                   (set-comment-style w :plain)
  81.                   (setup-undo w
  82.                               #'(lambda ()
  83.                                   (handle-set-comment-style w))
  84.                               "Redo Styled Comments"))
  85.               "Undo Styled Comments"))
  86.  
  87. ;;;
  88. ;;; Put an entry on the Edit menu
  89. ;;;
  90. (add-menu-items *edit-menu*
  91.                 (make-instance 'menu-item
  92.                   :menu-item-title *set-comment-menu-name*
  93.                   :menu-item-action #'(lambda ()
  94.                                         (handle-set-comment-style (front-window) ))
  95.                   :command-key #\I
  96.                   )
  97.                 )